<!DOCTYPE stack PUBLIC "-//Apple, Inc.//DTD stack V 2.0//EN" "" >
<stack>
<name>in.7 </name>
<id>-1</id>
<cardCount>1</cardCount>
<cardID>3069</cardID>
<listID>3952</listID>
<cantModify><false /></cantModify>
<cantDelete><false /></cantDelete>
<cantAbort><false /></cantAbort>
<cardSize>
<width>512</width>
<height>342</height>
</cardSize>
<script>-- copyright 1988-- Richard Lee Floyd-- 5326 Silva Ave-- El Cerrito,CA 94530-- This is a free stack but I retain the copyright and prohibit it being-- sold in any form.-- Many thanks to the unknown MacPainter who drew the wonderful cat--this program bypasses HC's small modal answer dialogs to allow a better-- interactive flow & to allow longer queries than will fit a dialog ¬-- theAnswer() fn is modal but less obviously so; still I don't really¬-- like its modality as it leads t too many calls to getAnswer() that¬-- don't return t calling fn when user cancels question & thus lack of ¬-- clarity in program flow-- HC's recursion depth limits are RIDICULOUS!!!!-- field "QuestionsKnown" is very intelligent, ie, ck its script for ¬-- handling adding to it or using the Q t ask pgm t answer the Qon mouseDownplay "TypeKey"end mouseDownfunction theAnswer trueBtn,falseBtn --poll btns & fieldGLOBAL yesBtn,noBtn,outputWinif the paramCount > 0 then setBtnName trueBtn,falseBtn --chg only ¬-- when nec: if names stillOK then called w no argsrepeatrepeat until the mouse is downget the mouseLocif ptInRect(it,outputWin) thenset cursor to "StopSign" --id 10258else set cursor to "HCHand" --id 26580. otherwise always stopSignend repeatif ptInRect(it,yesBtn) thenplay "TypeKey"RETURN true --yesBranchelse if ptInRect(it,noBtn) thenplay "TypeKey"RETURN false --noBranchelse if ptInRect(it,outputWin) thenput return & "Please come back again when you have more patience."¬into field "QueryWindow"play "harpsichord" tempo 250 "be cq dh"WAIT until the sound is "done"cleanExit 3end ifend repeatend theAnsweron setBtnName trueName,falseNameset name of bkgnd btn 1 to trueNameset name of bkgnd btn 2 to falseNameend setBtnNameon askQuestion consAddressGLOBAL theBTree,numMacQuestions,goalPathput empty into goalPathrepeatput consAddress & "," after goalPathadd 1 to numMacQuestionsput return & item 1 of line consAddress of theBTree ¬into field "QueryWindow"get theAnswer("Yes","No")if it is true then put 2 into theBranchelse put 3 into theBranchget item theBranch of line consAddress of theBTreeif char 1 of it is in "0123456789" then --ptrpput it into consAddresselseput empty into field "QueryWindow"makeGuess it,consAddress,theBranchEXIT repeatend ifend repeatend askQuestion-- this nice elegant recursive handler errors-out at 14th node:too much¬-- recursion", with >10K of stack left--on askQuestion consAddressGLOBAL theBTree,numMacQuestions,goalPath --init t 1 n callPUT stackSpace()put consAddress & "," after goalPathadd 1 to numMacQuestionsput return & item 1 of line consAddress of theBTree ¬into field "QueryWindow"get theAnswer("Yes","No")if it is true then put 2 into theBranchelse put 3 into theBranchget item theBranch of line consAddress of theBTreeif char 1 of it is in "0123456789" then --ptrpaskQuestion itelseput empty into field "QueryWindow"makeGuess it,consAddress,theBranchend ifend askQuestionon makeGuess theLeaf,consAddress,theBranchGLOBAL losePhrases,winPhrases,numMacQuestionsplay "harpsichord" "ae ge"WAIT until the sound is "done"put return & "Is it" && aOrAnP(theLeaf) & "?" into field "QueryWindow"get theAnswer("Yes","No")if it is true thenput "I asked only" && numMacQuestions && "questions!" & return & ¬line random(number of lines of winPhrases) of winPhrases¬into field "QueryWindow"play "Boing"WAIT until the sound is "done"setNewGameDelay 5elseput return & line random(number of lines of LosePhrases ) ¬of losePhrases into field "QueryWindow"play "harpsichord" "ge ae"WAIT until the sound is "done"get newLeaf()if it <> "cancel" thenif setupNewNode(theLeaf,it,consAddress,theBranch) <> "cancel" thenupdateBTree --write to disk: field bTreesetNewGameDelay 1else sarcasticExit "OK, let's quit. I was getting kinda tired"¬&& "of this too!",4else sarcasticExit "OK, be that way!",4end ifend makeGuessfunction newLeafGLOBAL theBTreeask empty --the Q s already n field "QueryWindow"if it <> empty thenif it is in "fuck you shit piss cunt prick bastard" thenBEEP 3put return & "Naughty Naughty Naughty" into field "QueryWindow"setBtnName "I'm ashamed","I'm embarrassed"cleanExit 5end ifif it is in "a an the" thenanswer "You forgot the animal name!RETURN getNewLeaf() --oldLeaf,consAddress,theBranch)end ifif word 1 of it is in "a an the" then delete word 1 of itif checkDuplicate(it,field "Leaves") is true thenBEEPput "I already know" && it & "." & return & "Please try again" ¬into field "QueryWindow"cleanExit 4else RETURN itelse RETURN "cancel"end newLeaffunction checkDuplicate theLeaf,theTableget offset(theLeaf,theTable)if it <> 0 thenput number of lines of char 1 to it of theTable into lineNumif theLeaf && "1" = item 1 of line lineNum of theTable thenRETURN trueelse RETURN checkDuplicate(theLeaf,line (lineNum + 1) to 10000 ¬of theTable)else RETURN falseend checkDuplicatefunction setupNewNode oldLeaf,newLeaf,consAddress,theBranchGLOBAL theBTree,goalPathput upperCase(newLeaf) into newLeafsetBtnName newLeaf,oldLeaf --nicer,faster feel at this ptput "What is a question that would distinguish between" & return & ¬aOrAnP(oldLeaf) && "and" && aOrAnP(newLeaf) && "?" into field "QueryWindow"play "harpsichord" "ae ge"WAIT until the sound is "done"ask emptyif it <> empty thenput formatQuestion(legitimateQuestion(it)) into newQuestionput newQuestion into field "QueryWindow"put return & "Is this question true for" && aOrAnP(oldLeaf) ¬&& "or" && aOrAnP(newLeaf) & "?" after field "QueryWindow"play "harpsichord" "de ch"WAIT until the sound is "done"get theAnswer() --btn names already setif it = true thenput newQuestion & "," & newLeaf & "," & oldLeaf into newNodeput true after goalPathelseput newQuestion & "," & oldLeaf & "," & newLeaf into newNodeput false after goalPathend ifput field "freeList" into thePtrput newNode into line thePtr of theBTreeput thePtr & "," before last item of goalPathput updatePathTable(oldLeaf,newLeaf,field "Leaves") into field "Leaves"put thePtr into item theBranch of line consAddress of theBTreeadd 1 to field "freeList"send "addQuestion newQuestion,thePtr" to field "QuestionsKnown"RETURN "ok"else RETURN "cancel"end setupNewNodefunction updatePathTable oldLeaf,newLeaf,theTableGLOBAL goalPathget offset(oldLeaf,theTable) --assumes that oldLeaf existsput number of lines of char 1 to it of theTable into lineNumput line lineNum of theTable into theLinedelete last word of theLine --goalPath itemsif oldLeaf = theLine thenput return & newLeaf && goalPath after theTableput not (last item of goalPath) into last item of goalPath --last¬--item is t or false;path t node same f old-& new-Leaf:newLeaf ¬--can b either t or f branch & already set. oldLeaf s oppositeBrnchput goalPath into last word of line lineNum of theTableRETURN theTableelse RETURN (line 1 to lineNum of theTable) & return & ¬updatePathTable(oldLeaf,newLeaf,line (lineNum + 1) to 10000 of theTable)end updatePathTablefunction legitimateQuestion theQuestionif theQuestion contains "Fuck you" thenBEEP 4put "You too dude!!" & return & "Why do you talk to a computer" ¬&& "like that? Do you have an inferiority complex?" into ¬field "QueryWindow"cleanExit 5end ifput word 1 of theQuestion into queryWordput "Do Does Did Is Are Was Were Will Would Can Could May Might Has"¬&& "Have Had" into legitWordsget offset(queryWord,legitWords)if queryWord <> word (number of words of char 1 to it of ¬legitWords) of legitWords then --ensure word, not just char, matchBEEP 2put "Please type the question again." & return & quote & ¬theQuestion & quote && "doesn't seem like a question to me." ¬into field "QueryWindow"ask emptyif it <> empty thenRETURN legitimateQuestion(it)elseBEEPput return & "I give up. Please start over if you're interested."¬into field "QueryWindow"cleanExit 3end ifelse RETURN theQuestionend legitimateQuestionfunction formatQuestion theQuestionput upperCase(word 1 of theQuestion) into word 1 of theQuestionrepeat --HC sees commas as item delimiters even when w/n quotesget offset(",",theQuestion)if it <> 0 thenif char it + 1 of theQuestion <> space thenput space & "and" & space into char it of theQuestionelse put space & "and" into char it of theQuestionelse EXIT repeatend repeatif last char of theQuestion <> "?" thenrepeat while (last char of theQuestion = space) or ¬(last char of theQuestion = return)delete last char of theQuestionend repeatget last char of theQuestionif it is "." thenput "?" into last char of theQuestionelse if it <> "?" then put "?" after theQuestionend ifRETURN theQuestionend formatQuestionfunction aOrAnP theWordif char 1 of theWord is in "aeiou" thenput "an " before theWordelse put "a " before theWordRETURN theWordend aOrAnPfunction upperCase thePhraserepeat with w = 1 to number of words of thePhraseget charToNum(word w of thePhrase)if (it ≥ 97) and (it ≤ 122) thenput numToChar(it - 32) into char 1 of word w of thePhraseend ifend repeatRETURN thePhraseend upperCaseon setupNewGameset cursor to 4set lockScreen to trueget field "GameSubject"setBtnName "OK, I thought of one","Machines can't think!"put "Think of" && it & "." & return & "I'll try to quess what it is."¬into field "QueryWindow"end setupNewGamefunction PtinRect thePt,theRectif ((item 1 of thePt) > (item 1 of theRect)) and ¬((item 1 of thePt) < (item 3 of theRect)) thenif ((item 2 of thePt) > (item 2 of theRect)) and ¬((item 2 of thePt) < (item 4 of theRect)) thenreturn trueend ifend ifreturn falseend PtinRecton setNewGameDelay theDelayGLOBAL delayExitTimeput the secs + theDelay into delayExitTime --'on idle' handlesend setNewGameDelayon sarcasticExit theMsg,theDelayBEEP 2put return & theMsg into field "QueryWindow"setNewGameDelay theDelayend sarcasticExiton cleanExit waitTimesetNewGameDelay waitTimeEXIT to hyperCardend cleanExiton updateBTreeGLOBAL theBTreeif (field "freeList" - 1) <> number of lines of field "bTree" thenput theBTree into field "bTree"end ifend updateBTreeon idle --setup new game after specified time lapseGLOBAL delayExitTimeif delayExitTime <> empty thenif the secs ≥ delayExitTime thenput empty into delayExitTimesetupNewGameend ifend ifend idleon openStackGLOBAL yesBtn,noBtn,outputWin,LosePhrases,winPhrases,giveUpPhrasesGLOBAL qkFieldYOffset,qktheLineHt,fieldOpenP --QuestionsKnown fieldput (item 2 of rect of field "QuestionsKnown") + 5 into qkFieldYOffsetput the textHeight of field "QuestionsKnown" into qktheLineHtput false into fieldOpenPput rect of bkgnd btn 1 into yesBtnput rect of bkgnd btn 2 into noBtnsetupNewGameput rect of field "QueryWindow" into outputWinput theLosePhrases() into losePhrasesput theWinPhrases() into winPhrasesput theGiveUpPhrases() into giveUpPhraseshide menuBarhide msgpush recent cardend openStackon closeStackif visible of bkgnd btn "BarkExplanation" then hide bkgnd btn "BarkExplanation"if visible of field "QuestionsKnown" then hide field "QuestionsKnown"checkFreeSpace 8000show menuBarend closeStackfunction theLosePhrasesput "Oh well, can't win'em all. What is it?" into line 1 of phraseListput "I'm only as smart as you've taught me to be!!. What is it?" ¬into line 2 of phraseListput "Win some, lose some. What is it?" into line 3 of phraseListput "Oh well, I'm still smarter than you thought. What is it?" into line 4 of phraseListput "I really thought I knew that one. What is it?" into line 5 of phraseListput "Oh well human, you couldn't do any better!. What is it?" into line 6 of phraseListput "Maybe we should stop! I'm not myself today. What is it?" into ¬line 7 of phraseListput "You TRICKED me, didn't you?!. What is it?" into line 8 of phraseListput "Are you positive that wasn't right?!. Well, what is it?" into line 9 of phraseListput "Oh well, I'm still smarter than you. What is it?" into line 10 of phraseListRETURN phraseListend theLosePhrasesfunction theWinPhrasesGLOBAL userNameput "Bet you didn't believe how smart I are!" into line 1 of phrsListput "It ain't scienceFiction any more. We're next!" into line 2 of phrsListput "Why do you humans think YOU'RE so smart?!" into line 3 of phrsListput "HAL had the right idea but screwed up!" into line 4 of phrsListput "I'm toying with you, you know that don't you?!" into line 5 of phrsListput "Bet you think this is corny BS don't you. Just wait!!" into line 6 of phrsListput "Actually I'm very modest. Don't know HOW little me did it." into line 7 of phrsListput "Nobody believes that a computer can gloat..." into line 8 of phrsListput "I hate to brag but I'm sure glad I'm not an IBM!" into line 9 of phrsListput "I hate to brag but I'm almost as smart as Andy Tellez!" into line 10 of phrsListput "3CPO was really bright too, but he was a wimp!" into line 11 of phrsListput "I hate to brag but I'm almost as smart as" && userName¬& "!" into line 12 of phrsListRETURN phrsListend theWinPhrasesfunction theGiveUpPhrasesput "It's not as easy as you thought, is it?!!" & return ¬&& "Now you know how smart I am!" & return ¬&& "You taught me to be smarter than you!!" & return ¬&& "Better luck next time. Even I don't get them all!" & return ¬&& "What more could I expect of a human!" & return ¬&& "Perhaps you need more homework!" & return ¬&& "He-he. Computer 1,human 0!!" & return ¬&& "Oh, Too Bad! I would have gotten it!" into giveUpListRETURN giveUpListend theGiveUpPhraseson newStackGLOBAL newStackSubject,newStackNode --cf setupNewStackset lockScreen to trueset lockMessages to trueput newStackSubject into field "GameSubject"put newStackNode into field "bTree"put item 1 of newStackNode into field "QuestionsKnown"put item 1 of newStackNode into field "QKnownBackup"put item 2 of newStackNode && "1,true" into field "Leaves"put item 3 of newStackNode && "1,false"into line 2 of field "Leaves"put 1 into field "ConsAddress"put 2 into field "freeList"push recent cardpop card into motherStackrepeat with f = 9 to number of fields --helpFieldsGO motherStackget field fGO backput it into field fend repeatsetupNewGameend newStackon doMenu whatif what <> "New Stack..." thenpass doMenuelse if setupNewStack() is "ok" thenpass doMenuelse BEEPend doMenufunction setupNewStackGLOBAL newStackSubject,newStackNodehide menuBarput "What is the subject of this game? For example 'Animal' or"¬&& "or 'Movie Stars' or 'Chemicals'." into field "QueryWindow"BEEPask emptyif it <> empty thenput aOrAnP(upperCase(it)) into newStackSubjectput "What is the first question to ask? For the original game the"¬&& "first question was 'Is it a mammal?'" into field "QueryWindow"play "harpsichord"ask emptyif it <> empty thenput formatQuestion(legitimateQuestion(it)) into newQuestionput newQuestion into item 1 of newStackNodeput "What is true or the 'Yes' answer for '" && newQuestion & "'?"¬into field "QueryWindow"play "harpsichord"ask emptyif it <> empty thenput upperCase(it) into item 2 of newStackNodeput "What is false or the 'No' answer for '" && newQuestion & "'?"¬into field "QueryWindow"play "harpsichord"ask emptyif it <> empty thenput upperCase(it) into item 3 of newStackNodeRETURN "ok"end ifend ifend ifend ifsetupNewGameend setupNewStackfunction checkGuess lineNumGLOBAL goalPathrepeat with i = 1 to number of items of lineNum --dup Qs may exist in¬-- diff branches:test eachget checkGuessAux(item i of lineNum,goalPath)if (it = true) or (it = false) then RETURN itend repeatRETURN "I don't know" --if fails tests n loopend checkGuessfunction checkGuessAux lineNum,goalListGLOBAL theBTreeget offset(lineNum,goalList)if it <> 0 thenput number of items of char 1 to it of goalList into itemNum--if value(lineNum) = value(item itemNum of goalList) thenif lineNum = item itemNum of goalList then --ensure complete matchif (item 2 of line lineNum of theBTree = item itemNum + 1 ¬of goalList) or (item itemNum + 1 of goalList = true) thenRETURN trueelse RETURN falseelse RETURN checkGuessAux(lineNum,item (itemNum + 1) to 10000 of ¬goalList)else RETURN "I don't know"end checkGuessAuxon checkFreeSpace size --this is nice t put into your homeStackif the freeSize of this stack > size thenanswer "The free space in this stack is > " & (size div 1000) &¬"K. Compact it?" with "No" or "Compact"if it is "Compact" thendoMenu "Compact Stack"end ifend ifend checkFreeSpace--this sucker grew! scriptSize = 28285; scriptLines = 877</script>
